home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib10.dsk / SHOPPING LIST.bas < prev    next >
BASIC Source File  |  2023-02-26  |  20KB  |  515 lines
  1. 10  REM  ****************************
  2. 11  REM  *   SHOPPING LIST 1.0      *
  3. 12  REM  *   BY C.J. ENGELSHER      *
  4. 13  REM  *   COPYRIGHT (C) 1982     *
  5. 14  REM  *   BY MICRO-SPARC INC     *
  6. 15  REM  *   LINCOLN, MA. 01773     *
  7. 16  REM  *   ALL RIGHTS RESERVED    *
  8. 17  REM  ****************************
  9. 89  REM 
  10. 90  REM  &&&&&&&& MAIN &&&&&&&&
  11. 91  REM 
  12. 100 PM$(1) = "INITIALIZING":MN = 10:FLNAME$ = "NONE":FLGT = 0:P$ = "OFF"
  13. 110  GOSUB 500: REM  INITIALIZE
  14. 120  GOSUB 1000: REM  READ CHECK
  15. 130  GOSUB 1200: REM  READ CATALOG
  16. 140  GOSUB 1400: REM  RENAME QUERY
  17. 144  REM 
  18. 145  REM  ******** MENU ********
  19. 146  REM 
  20. 150  HOME : GOSUB 11500
  21. 180  FOR I = CLGT +2 TO CLGT +4:CTL$(I) = " ": NEXT I: REM  BLANKS FOR LISTING OPTIONS
  22. 200  VTAB 4: FOR I = 1 TO 9: PRINT MN$(I): NEXT I
  23. 205 PM$(1) = "***PLEASE SELECT FROM MENU***":MN = 10: GOSUB 800
  24. 210  GET IN$
  25. 215  IF (IN$ <"A")  OR (IN$ >"Z")  THEN 210
  26. 220 MN =  ASC(IN$) -64
  27. 230  ON MN GOSUB 2000,3000,4000,5000,6000,7000,8000,9000,250
  28. 240  GOTO 150
  29. 250  POKE 35,24: HOME : END 
  30. 251  REM 
  31. 252  REM  &&&&& END OF MAIN &&&&&
  32. 405 FLNAME$ = NW$: GOSUB 9500: GOSUB 800
  33. 487  REM  
  34. 498  REM  ***** INITIALIZE *****
  35. 499  REM 
  36. 500 D$ =  CHR$(13) + CHR$(4)
  37. 505 C = 0: REM  COUNTER FOR # OF FILE-READS >> LN# 10045 FREES UNUSED STRING SPACE AFTER 20 SUCH READS.
  38. 510  HOME : PRINT D$;"NOMON C,I,O"
  39. 520  DEF  FN MOD(X) =  INT((X/DN - INT(X/DN)) *DN +.05)
  40. 530  ONERR  GOTO 900
  41. 540  DIM MN$(15),CTL$(30),FILE$(200)
  42. 542  DIM ADD$(100),DLE$(20),MERGE$(200)
  43. 550 MN$(0) = "INITIAL SET-UP OF 1ST FILE "
  44. 560 MN$(1) = "A-LIST CATALOG OF FILES    "
  45. 570 MN$(2) = "B-LIST CONTENTS / ALL FILES"
  46. 580 MN$(3) = "C-LIST CONTENTS:FILE IN MEM"
  47. 590 MN$(4) = "D-SELECT AN EXISTING FILE  "
  48. 600 MN$(5) = "E-CREATE A NEW FILE        "
  49. 610 MN$(6) = "F-RENAME AN EXISTING FILE  "
  50. 620 MN$(7) = "G-ADD ITEMS TO FILE IN MEM "
  51. 630 MN$(8) = "H-DELETE ITEMS FROM F.I.M. "
  52. 640 MN$(9) = "I-QUIT                     "
  53. 650 MN$(10) = "                           "
  54. 660 PH$(0) = " ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
  55. 670 PH$(1) = ""
  56. 680 PH$(2) = "MENU MODE...:"
  57. 690 PH$(3) = "FILE IN MEMRY"
  58. 700 PH$(4) = "PRINTER.....:"
  59. 720  POKE 35,19: VTAB (20): PRINT PH$(0)
  60. 730  REM  POKE TABLE OF SCREEN BASE ADDRESSES OF PROMPT WINDOW INTO MEMORY BEGIN'G AT $382(!898):
  61. 732  POKE 898,80: POKE 899,6: POKE 900,208: POKE 901,6
  62. 734  POKE 902,80: POKE 903,7: POKE 904,208: POKE 905,7
  63. 736  REM  THESE ARE LO/HI BYTE BASE ADRS. OF LINES 21-24
  64. 797  REM 
  65. 798  REM  ******* PROMPT *******
  66. 799  REM 
  67. 800 PM$(2) = MN$(MN):PM$(3) = ":" +FLNAME$ +"/" + STR$(FLGT):PM$(4) = P$
  68. 810  FOR J = 1 TO 4: VTAB (20 +J): HTAB 1: CALL  -868: NEXT J
  69. 820  FOR J = 1 TO 4:BASLH =  PEEK(896 +2 *J) + PEEK(896 +2 *J +1) *256:PT$(J) = PH$(J) +PM$(J): FOR K = 1 TO  LEN(PT$(J)): POKE (BASLH +K -1), ASC( MID$ (PT$(J),K,1)) +128: NEXT K,J
  70. 850  VTAB 19: HTAB 1: RETURN 
  71. 896  REM 
  72. 897  REM  ******* MAIN ********
  73. 898  REM  ***** ERR ROUTN *****
  74. 899  REM 
  75. 900  PRINT D$;"CLOSE": REM  GEN'L PRECAUTION.
  76. 910 X =  PEEK(218) + PEEK(219) *256:Y =  PEEK(222): REM  LN# & ERR CODE.
  77. 920  IF X = 1020  AND Y = 5  THEN 1800: REM  GOTO 1ST ENTRY FOR A NEW DISC.
  78. 930  PRINT "ERR CODE=";Y;"----LN#=";X
  79. 935  REM  SEE CALL-APPLE SEPT 80 FOR WAY OF PRINTING FULL ERROR MESSAGES. SEE NIBBLE VOL2/#2 FOR 'ONERR QUIRKS'.
  80. 940  GOTO 250
  81. 997  REM 
  82. 998  REM  ***** READ CHECK *****
  83. 999  REM 
  84. 1000  PRINT D$;"OPEN CHECK,L20"
  85. 1010  PRINT D$;"READ CHECK"
  86. 1020  INPUT CK$(0),CK$(1)
  87. 1030  PRINT D$;"CLOSE": RETURN 
  88. 1197  REM 
  89. 1198  REM  ***** READ CATALOG ****
  90. 1199  REM 
  91. 1200 CLGT =  VAL(CK$(1))
  92. 1220  PRINT D$;"OPEN ";CK$(0);" ,L20"
  93. 1230  PRINT D$;"READ ";CK$(0)
  94. 1240  FOR I = 0 TO CLGT +1: INPUT CTL$(I): NEXT I
  95. 1250  PRINT D$;"CLOSE": RETURN 
  96. 1397  REM 
  97. 1398  REM  **** RENAME QUERY ****
  98. 1399  REM 
  99. 1400 PM$(1) = "RENAME QUERY":MN = 10:FLNAME$ = "NONE":FLGT = 0:P$ = "OFF": GOSUB 800
  100. 1410  VTAB 8: GOSUB 11500
  101. 1430  VTAB 15: PRINT "DO YOU WANT TO CHANGE THE NAME OF": PRINT "THIS CATALOG ? (Y/N)"
  102. 1440  GET IN$
  103. 1450  IF IN$ = "Y"  THEN 1600
  104. 1460  IF IN$ = "N"  THEN 1480
  105. 1470  GOTO 1440
  106. 1480  RETURN 
  107. 1597  REM 
  108. 1598  REM  ***** RENAME CAT *****
  109. 1599  REM 
  110. 1600  INVERSE : PRINT : PRINT "TYPE IN NEW CATALOG NAME:": INPUT IN$:CTL$(0) =  LEFT$(IN$,20)
  111. 1605  NORMAL 
  112. 1610  GOSUB 10500
  113. 1650  PRINT D$;"DELETE ";CK$(0)
  114. 1660 CK$(0) = CTL$(0)
  115. 1670  GOSUB 11000
  116. 1680  RETURN 
  117. 1797  REM 
  118. 1798  REM  ***** FIRST ENTRY *****
  119. 1799  REM 
  120. 1800 PM$(1) = MN$(0):PM$(2) = "FIRST ENTRY":FLNAME$ = "NONE":FLGT = 0:P$ = "OFF": GOSUB 800
  121. 1810  HOME : VTAB 10: PRINT "NO CATALOG OR FILES EXIST."
  122. 1820  PRINT "FIRST, SELECT A CATALOG NAME."
  123. 1830  INPUT IN$:CK$(0) =  LEFT$(IN$,20):CTL$(0) = CK$(0)
  124. 1840  PRINT : PRINT "NOW, SELECT A NAME FOR YOUR 1ST FILE."
  125. 1850  INPUT IN$:FLNAME$ =  LEFT$(IN$,20)
  126. 1860  GOSUB 8100: REM  ADD-ITEM INPUT SECTION
  127. 1870 PM$(1) = "1ST FILE ENTERED. NOW UPDTAING CATALOG.": GOSUB 800
  128. 1880 CLGT = 1:CK$(1) = "1":CTL$(1) = "1":CTL$(2) = FLNAME$
  129. 1890  GOSUB 11000: REM  WRITE CHECK
  130. 1900  GOSUB 10500: REM  WRITE CAT.
  131. 1910  GOTO 150: REM  "RETURN" ALREADY POP'ED BY ONERR STATEMENT EXECUTION!
  132. 1997  REM 
  133. 1998  REM  **** LIST CATALOG ****
  134. 1999  REM 
  135. 2000  HOME :PM$(1) = MN$(10): GOSUB 800
  136. 2010  GOSUB 11500: REM  TITLE
  137. 2030  PRINT : PRINT : PRINT "DO YOU WANT THE PRINTER ON? (Y/N)"
  138. 2040  GET IN$
  139. 2042  IF IN$ = "Y"  THEN 2200
  140. 2044  IF IN$ = "N"  THEN 2400
  141. 2046  GOTO 2040
  142. 2197  REM 
  143. 2198  REM  **** PRINTER ON ****
  144. 2199  REM 
  145. 2200 PM$(1) = "PRESS 'ESC' TO EXIT TO MENU.":P$ = "ON": GOSUB 800
  146. 2210  PRINT D$;"PR#1": REM  GOSUB TO A PRINTER DRIVER ROUTINE IF NEC.
  147. 2230  PRINT "CATALOG NAME---";CK$(0): PRINT "NMBR OF FILES--";CLGT
  148. 2235  PRINT : PRINT : PRINT 
  149. 2240  FOR I = 2 TO CLGT +1  STEP 4
  150. 2250  PRINT CTL$(I);: POKE 36,20: PRINT CTL$(I +1);: POKE 36,40: PRINT CTL$(I +2);: POKE 36,60: PRINT CTL$(I +3)
  151. 2260 X =  PEEK( -16384): POKE  -16368,0: IF X = 27  THEN 2290: REM  ASCII ESC
  152. 2280  NEXT I
  153. 2290  PRINT D$;"PR#0":P$ = "OFF": RETURN 
  154. 2397  REM 
  155. 2398  REM  **** PRINTER OFF ****
  156. 2399  REM 
  157. 2400 PM$(1) = "ESC FOR MENU---SPACE BAR TO SCROLL": GOSUB 800
  158. 2410  HOME :DN = 18: REM  FOR SCROLLING
  159. 2420  FOR I = 2 TO CLGT +1  STEP 2
  160. 2430  PRINT CTL$(I); TAB( 21);CTL$(I +1)
  161. 2440  IF  FN MOD(I/2) < >0  THEN 2470
  162. 2460  GET IN$
  163. 2462  IF IN$ =  CHR$(27)  THEN  RETURN 
  164. 2464  IF IN$ =  CHR$(32)  THEN 2470
  165. 2466  GOTO 2460
  166. 2470  NEXT I
  167. 2480 PM$(1) = "END OF LISTING---USE ESC FOR MENU": GOSUB 800
  168. 2490  GET IN$
  169. 2495  IF IN$ =  CHR$(27)  THEN  RETURN 
  170. 2497  GOTO 2490
  171. 2997  REM 
  172. 2998  REM  ****** LIST ALL ******
  173. 2999  REM 
  174. 3000  HOME :PM$(1) = MN$(10): GOSUB 800
  175. 3010  GOSUB 11500: REM  TITLE
  176. 3020  PRINT : PRINT : PRINT "DO YOU WANT PRINTER ON?(Y/N)"
  177. 3030  GET IN$
  178. 3032  IF IN$ = "Y"  THEN 3200
  179. 3034  IF IN$ = "N"  THEN 3400
  180. 3036  GOTO 3030
  181. 3197  REM 
  182. 3198  REM  *** PRINTER ON ***
  183. 3199  REM 
  184. 3200 PM$(1) = "PRESS 'ESC' TO RETURN TO MENU"
  185. 3210  PRINT D$;"PR#1":P$ = "ON"
  186. 3220  PRINT  TAB( CTR);CTL$(0): PRINT  TAB( CTR -4);CLGT;" FILES": PRINT : PRINT : PRINT 
  187. 3230  FOR I = 2 TO CLGT +1
  188. 3240 FLNAME$ = CTL$(I): PRINT D$;"PR#0": GOSUB 10000: REM  READ FILE
  189. 3245  GOSUB 800: PRINT D$;"PR#1": PRINT : PRINT FLNAME$;":": PRINT 
  190. 3247  GOSUB 4600: IF X = 27  THEN 3270: REM  2ND LEVEL ROUTING OF RETURN FR. LISTONE/ON.
  191. 3250  PRINT : PRINT PM$(0);PM$(0): PRINT 
  192. 3260  NEXT I
  193. 3270  PRINT D$;"PR#0":P$ = "OFF": RETURN 
  194. 3299  REM 
  195. 3397  REM 
  196. 3398  REM  **** PRINTER OFF ****
  197. 3399  REM 
  198. 3400  HOME 
  199. 3410  FOR I = 2 TO CLGT +1
  200. 3415 FLNAME$ = CTL$(I):PM$(1) = "NOW LOADING....." +FLNAME$: GOSUB 800
  201. 3420  GOSUB 10000
  202. 3425 PM$(1) = "ESC FOR MENU +++ SPACE BAR TO CONTINUE.": GOSUB 800
  203. 3430  HOME : GOSUB 4700
  204. 3435  CALL  -198:PM$(1) = "END OF CURR FILE:ESC OR NXT FILE(SP-BAR)": GOSUB 800
  205. 3437  GET IN$
  206. 3438  IF IN$ =  CHR$(27)  THEN  RETURN 
  207. 3439  IF IN$ < > CHR$(32)  THEN 3437
  208. 3440  NEXT I
  209. 3445  CALL  -198: CALL  -198: CALL  -198:PM$(1) = "END OF ALL FILES >>> ESC FOR MENU": GOSUB 800
  210. 3450  GET IN$
  211. 3452  IF IN$ =  CHR$(27)  THEN  RETURN 
  212. 3454  GOTO 3450
  213. 3997  REM 
  214. 3998  REM  ****** LIST FIM ******
  215. 3999  REM 
  216. 4000 PM$(1) = MN$(10): HOME : GOSUB 800: IF FLNAME$ = "NONE"  THEN 4030
  217. 4010  VTAB 10: PRINT "DO YOU WANT PRINTER TURNED ON (Y/N)?"
  218. 4020  GET IN$
  219. 4022  IF IN$ = "Y"  THEN 4200
  220. 4024  IF IN$ = "N"  THEN 4400
  221. 4026  GOTO 4020
  222. 4030  VTAB 5: CALL  -198: FLASH : PRINT "NO FILES IN MEMORY.": NORMAL 
  223. 4040  PRINT : PRINT "PLACE A FILE IN MEMORY USING THE ": PRINT "MENU OPTIONS 'A' AND 'D'."
  224. 4050  FOR D = 1 TO 3000: NEXT D: RETURN 
  225. 4197  REM 
  226. 4198  REM  **** PRINTER ON ****
  227. 4199  REM 
  228. 4200 PM$(1) = "ESC TO EXIT TO MENU":P$ = "ON": GOSUB 800: PRINT D$;"PR#1"
  229. 4210  PRINT FLNAME$;":": PRINT 
  230. 4220  GOSUB 4600
  231. 4230 P$ = "OFF": PRINT D$;"PR#0"
  232. 4240  RETURN 
  233. 4397  REM 
  234. 4398  REM  **** PRINTER OFF ****
  235. 4400  HOME 
  236. 4410 PM$(1) = "ESC FOR MENU --- SPACE BAR TO SCROLL": GOSUB 800
  237. 4420  GOSUB 4700
  238. 4430  IF J >FLGT +1  THEN PM$(1) = "END OF LISTING---ESC FOR MENU."
  239. 4432  IF J < = FLGT +1  THEN PM$(1) = "LISTING TERMINATED---ESC FOR MENU."
  240. 4434  GOSUB 800
  241. 4440  GET IN$
  242. 4442  IF IN$ =  CHR$(27)  THEN  RETURN 
  243. 4444  GOTO 4440
  244. 4450  RETURN 
  245. 4497  REM 
  246. 4498  REM  ******* LISTONE ********
  247. 4499  REM 
  248. 4500  REM 
  249. 4597  REM 
  250. 4598  REM  *** PRINTER ON ***
  251. 4599  REM 
  252. 4600  FOR J = 2 TO FLGT +1  STEP 4
  253. 4609  REM  4-CLM FORMAT
  254. 4610  PRINT FILE$(J);: POKE 36,20: PRINT FILE$(J +1);: POKE 36,40: PRINT FILE$(J +2);: POKE 36,60: PRINT FILE$(J +3)
  255. 4620 X =  PEEK( -16384): POKE  -16368,0: IF X = 27  THEN  RETURN : REM  SEE LN#3247 LIST ALL/ON.
  256. 4630  NEXT J
  257. 4640  RETURN 
  258. 4697  REM 
  259. 4698  REM  *** PRINTER OFF ***
  260. 4699  REM 
  261. 4700  HOME :DN = 18: REM  FOR SCROLL
  262. 4709  REM  2-CLM FORMAT
  263. 4710  FOR J = 2 TO FLGT +1  STEP 2
  264. 4720  PRINT FILE$(J); TAB( 21);FILE$(J +1)
  265. 4740  IF  FN MOD(J/2) < >0  THEN 4770
  266. 4760  GET IN$
  267. 4762  IF IN$ =  CHR$(27)  THEN  RETURN 
  268. 4764  IF IN$ =  CHR$(32)  THEN 4770
  269. 4766  GOTO 4760
  270. 4770  NEXT J
  271. 4780  RETURN 
  272. 4997  REM 
  273. 4998  REM  ******* SELECT *******
  274. 4999  REM 
  275. 5000 PM$(1) = MN$(10): GOSUB 800
  276. 5005  HOME 
  277. 5010  VTAB 8: PRINT "'SELECT' LOADS AN EXISTING FILE INTO": PRINT "MEMORY. PLEASE TYPE FILE NAME DESIRED."
  278. 5020  INPUT IN$:IN$ =  LEFT$(IN$,20)
  279. 5030  FOR I = 2 TO CLGT +1
  280. 5040  IF IN$ = CTL$(I)  THEN 5200: REM  READ FILE$
  281. 5050  NEXT I
  282. 5060  REM  OTHERWISE FILE DOESN'T EXIST
  283. 5070  PRINT : PRINT : CALL  -198: FLASH : PRINT "FILE DOES NOT EXIST": NORMAL 
  284. 5080  PRINT : PRINT "RETURN TO MENU WITH ESC--OR--SELECT": PRINT "ANOTHER FILE NAME USING SPACE BAR"
  285. 5090  GET IN$
  286. 5092  IF IN$ =  CHR$(27)  THEN  RETURN 
  287. 5094  IF IN$ =  CHR$(32)  THEN 5005
  288. 5096  GOTO 5090
  289. 5200 FLNAME$ = IN$
  290. 5210  GOSUB 10000: REM  READ FLNAME$
  291. 5280  RETURN 
  292. 5997  REM 
  293. 5998  REM  ******* CREATE *******
  294. 5999  REM 
  295. 6000 PM$(1) = MN$(10): GOSUB 800
  296. 6010  HOME : VTAB 8
  297. 6020  PRINT "TO CREATE A NEW FILE, SPECIFY A ": PRINT "FILE NAME THAT DOES NOT ALREADY EXIST."
  298. 6030  INPUT IN$:IN$ =  LEFT$(IN$,20)
  299. 6035  IF  LEN(IN$) = 0  THEN 6010
  300. 6040  FOR I = 2 TO CLGT +1: IF IN$ = CTRL$(I)  THEN 6400: NEXT I
  301. 6050 FLNAME$ = IN$:FLGT = 0:FILE$(2) = "": REM  ALLOWS 1ST ITEM IF DIFF FILES TO BE THE SAME
  302. 6060  GOSUB 8000: REM  ADD
  303. 6070  IF IN$ = ""  THEN 6200: REM  FLAG INDICATING ADD RTN. WENT TO COMPLETION (LN#8740)--
  304. 6080 FLNAME$ = FILE$(0):FLGT =  VAL(FILE$(1)): RETURN : REM  --ELSE RESTORE ORIG PARAMETERS & RETURN
  305. 6200  GOSUB 12000: REM  SEARCH/SORT CATALOG
  306. 6300 PM$(1) = "    NOW UPDATING CATALOG": GOSUB 800
  307. 6310 CTL$(1) =  STR$(CLGT):CK$(1) = CTL$(1)
  308. 6320  GOSUB 11000: REM  WRITE CHECK
  309. 6330  GOSUB 10500: REM  WRITE CATALOG.
  310. 6360  HOME : CALL  -198: VTAB 10: PRINT "NEW FILE ";
  311. 6365  INVERSE : PRINT FLNAME$;: NORMAL : PRINT " CREATED."
  312. 6370  FOR D = 1 TO 3000: NEXT D: RETURN 
  313. 6398  REM  **CREATE ERR-ROUTINE**
  314. 6400  PRINT : PRINT : CALL  -198: FLASH : PRINT "FILE NAME ALREADY ASSIGNED": NORMAL 
  315. 6410  PRINT : PRINT "RETURN TO MENU WITH 'ESC' -- OR --": PRINT : PRINT "CHOOSE ANOTHER FILE NAME USING SPACE-BAR"
  316. 6420  GET IN$
  317. 6422  IF IN$ =  CHR$(27)  THEN  RETURN 
  318. 6424  IF IN$ =  CHR$(32)  THEN 6010
  319. 6426  GOTO 6420
  320. 6997  REM 
  321. 6998  REM  **** RENAME A FILE ****
  322. 6999  REM 
  323. 7000 PM$(1) = MN$(10): GOSUB 800
  324. 7010  HOME : VTAB 8: PRINT "TYPE IN FILE TO BE RENAMED:"
  325. 7020  INPUT IN$:OLD$ =  LEFT$(IN$,20)
  326. 7029  REM  ***** CK OLD$ *****
  327. 7030  FOR I = 2 TO CLGT +1: IF OLD$ = CTL$(I)  THEN 7100: NEXT I: REM  LOCATE POSIT OF OLDNAME, IF IT EXISTS.
  328. 7040  GOTO 7500: REM  ERR ROUTINE
  329. 7100  PRINT : PRINT "TYPE IN NEW NAME:"
  330. 7105  INPUT IN$:NW$ =  LEFT$(IN$,20)
  331. 7109  REM  ***** CK NEW$ *****
  332. 7110  FOR J = 2 TO CLGT +1: IF NW$ = CTL$(J)  THEN 7510: NEXT J
  333. 7199  REM  *** RENAME BODY ***
  334. 7200 PM$(1) = "NOW RENAMING FILE.": GOSUB 800
  335. 7210  FOR J = I TO CLGT:CTL$(J) = CTL$(J +1): NEXT J: REM  MOVE DOWN, OLDNAME WRITTEN OVER.
  336. 7220 CLGT = CLGT -1:FLNAME$ = NW$: GOSUB 12000: REM  SEARCH & INSERT INTO CATALOG.
  337. 7299  REM  **** UPDATE CATALOG ****
  338. 7300  GOSUB 10500: REM  WRITE CAT.
  339. 7396  REM 
  340. 7397  REM  **** UPDATE FILE ****
  341. 7398  REM  READ OLD/SAVE AS NEW
  342. 7400 FLNAME$ = OLD$: GOSUB 10000: REM  READ UNDER OLD NAME,
  343. 7405 FLNAME$ = NW$:FILE$(0) = NW$: GOSUB 9500: REM  WRITE AS NW$.
  344. 7460  PRINT D$;"DELETE ";OLD$
  345. 7470  PRINT : PRINT : INVERSE : PRINT "RENAME FUNCTION NOW COMPLETE.": PRINT "NOW RETURNING TO THE MENU.": NORMAL 
  346. 7480  FOR D = 1 TO 1500: NEXT D: RETURN 
  347. 7498  REM 
  348. 7499  REM  *** RENAME ERR ***
  349. 7500  PRINT : PRINT : CALL  -198: FLASH : PRINT "FILE NAME DOES NOT EXIST.": NORMAL : GOTO 7520
  350. 7510  PRINT : PRINT : CALL  -198: FLASH : PRINT "FILE NAME ALREADY ASSIGNED.": NORMAL 
  351. 7520  PRINT "RETURN TO MENU WITH 'ESC' --OR--"
  352. 7525  PRINT "CHOOSE AN EXISTING FILE NAME,": PRINT "USING THE SPACE BAR."
  353. 7530  GET IN$
  354. 7532  IF IN$ =  CHR$(27)  THEN  RETURN 
  355. 7534  IF IN$ =  CHR$(32)  THEN 7000
  356. 7536  GOTO 7530
  357. 7997  REM 
  358. 7998  REM  ******** ADD ********
  359. 7999  REM 
  360. 8000 PM$(1) = MN$(10): GOSUB 800:ADD$(1) = "": REM  AVOIDS RARE INSTANCE OF DUPL. LEFTOVER FROM A PRIOR ADD.
  361. 8005  IF FLNAME$ = "NONE"  THEN 8800
  362. 8010  HOME : VTAB 5
  363. 8020  PRINT "CURRENT MODE ADDS TO OR CREATES ": PRINT "A FILE CALLED, ";FLNAME$;"."
  364. 8030  PRINT "DO YOU WANT TO CONTINUE (C), OR ": PRINT "TO RETURN TO THE MENU (M)?"
  365. 8040  GET IN$
  366. 8042  IF IN$ = "C"  THEN 8100
  367. 8044  IF IN$ = "M"  THEN  RETURN 
  368. 8046  GOTO 8040
  369. 8100 ALGT = 0: HOME 
  370. 8110 PM$(1) = "ENTER ITEM--'#' 4 #ADDED-CTL/E TO EXEC": GOSUB 800
  371. 8120  INPUT IN$:IN$ =  LEFT$(IN$,20)
  372. 8130  IF  LEFT$(IN$,1) =  CHR$(5)  AND (ALGT >0)  THEN 8200
  373. 8135  IF IN$ = "#"  THEN  GOTO 8900
  374. 8140  IF  LEN(IN$) = 0  THEN 8120
  375. 8160 ALGT = ALGT +1:ADD$(ALGT) = IN$
  376. 8170  GOTO 8120
  377. 8198  REM  ***** SELECTION *****
  378. 8199  REM  ******* SORT ********
  379. 8200 PM$(1) = " NOW SORTING AND MERGING.": CALL  -198: GOSUB 800
  380. 8210  FOR I = 1 TO ALGT -1
  381. 8215 MIN$ = ADD$(I):MLOC = I:S = 0
  382. 8220  FOR J = I +1 TO ALGT
  383. 8225  IF ADD$(J) =  >MIN$  THEN 8230
  384. 8227 MIN$ = ADD$(J):MLOC = J:S = 1
  385. 8230  NEXT J
  386. 8235  IF S = 0  THEN 8250
  387. 8240 ADD$(MLOC) = ADD$(I):ADD$(I) = MIN$: REM  SWITCH.
  388. 8250  NEXT I
  389. 8260 PM$(1) = "SORT DONE. NOW MERGING WITH FILE.": CALL  -198: GOSUB 800
  390. 8300  IF MN = 7  THEN 8500: REM  MERGE IF ADD SELECTED
  391. 8310 FILE$(0) = FLNAME$: REM  ELSE PUT ADD$ INTO FILE$ DIRECTLY,IE ADD CALLED BY 'CREATE' OR 'FIRST ENTRY'.
  392. 8320 I = 1:J = 0:D = 0: REM  FILE$,ADD$ INDICES & DUPL CNTR.
  393. 8330 I = I +1:J = J +1
  394. 8340  IF J >ALGT  THEN 8380
  395. 8350 FILE$(I) = ADD$(J)
  396. 8360  IF FILE$(I) < >ADD$(J +1)  THEN 8330: REM  CKS FOR NO MORE THAN 1 DUPL ENTRY IN ADD$.
  397. 8370 J = J +1:D = D +1: GOTO 8330
  398. 8380 FLGT = ALGT -D: GOTO 8700: REM  UPDATE FILE$ TO DISC.
  399. 8498  REM  ****** MERGE ******
  400. 8500 I = 2:J = 0:K = 1: REM  INDICES FOR FILE$,ADD$ &MERGE$ RESP.
  401. 8503 D =  -1: REM  DUPLICATE COUNTER
  402. 8505 J = J +1:D = D +1
  403. 8510  IF FILE$(I) >ADD$(J)  THEN 8550
  404. 8515  IF FILE$(I) = ADD$(J)  THEN 8505: REM  DUPL BET ADD$ & FILE$.
  405. 8517  IF ADD$(J) = ADD$(J +1)  THEN 8505
  406. 8520 MERGE$(K) = FILE$(I):K = K +1:I = I +1
  407. 8530  GOTO 8600: REM  CK IF FILE OR ADD ARE DONE
  408. 8549  REM  ALTERNATIVELY PUT ADD$ ELEMENT INTO FILE$
  409. 8550  IF ADD$(J) = ADD$(J +1)  THEN 8505: REM  CK FOR DUPL WITHIN ADD$ FIRST.
  410. 8560 MERGE$(K) = ADD$(J):K = K +1:J = J +1
  411. 8599  REM  ***CK IF DONE***
  412. 8600  IF I < = FLGT +1  THEN 8620: REM  FILE DONE?
  413. 8610 X = J: FOR J = X TO ALGT:MERGE$(K) = ADD$(J):K = K +1: NEXT J: GOTO 8650: REM  YES, FINISH REST OF ADD$.
  414. 8620  IF J < = ALGT  THEN 8510: REM  NO. ADD$ DONE?
  415. 8630 Y = I: FOR I = Y TO FLGT +1:MERGE$(K) = FILE$(I):K = K +1: NEXT : REM  YES,PUT REST OF FILE$ INTO MERGE$
  416. 8649  REM  ***NOW TRANSFER MERGE$ INTO FILE$***
  417. 8650 FLGT = FLGT +ALGT -D
  418. 8660  FOR I = 2 TO FLGT +1:FILE$(I) = MERGE$(I -1): NEXT I
  419. 8697  REM 
  420. 8698  REM  UPDAT FILE$ TO DISC:
  421. 8699  REM 
  422. 8700 FILE$(1) =  STR$(FLGT)
  423. 8710 PM$(1) = "MERGE DONE. NOW UPDATING FILE TO DISC.": CALL  -198: GOSUB 800
  424. 8720  GOSUB 9500: REM  WRITE A FILE.
  425. 8740 IN$ = "": RETURN : REM  FOR CREATE LN#6070
  426. 8800  HOME : VTAB 5: CALL  -198: FLASH : PRINT "NO FILES IN MEMORY.": NORMAL : PRINT : PRINT "RETURNING TO MENU...SELECT MENU OPTIONS": PRINT "'A' AND 'D'."
  427. 8810  FOR D = 1 TO 3000: NEXT D: RETURN 
  428. 8900  PRINT "# ITEMS ENTERED SO FAR = ";ALGT: GOTO 8120
  429. 8997  REM 
  430. 8998  REM  ****** DELETE ******
  431. 8999  REM 
  432. 9000  IF FLNAME$ = "NONE"  THEN 9480
  433. 9005 PM$(1) = MN$(10): GOSUB 800: HOME 
  434. 9010  PRINT "CURRENT MENU MODE DELETES ITEMS": PRINT "FROM THE FILE CURRENTLY IN MEMORY, ": PRINT FLNAME$;". DO YOU WANT TO": PRINT "CONTINUE (C) OR RETURN TO MENU (M)?"
  435. 9020  GET IN$
  436. 9022  IF IN$ = "C"  THEN 9100
  437. 9024  IF IN$ = "M"  THEN  RETURN 
  438. 9026  GOTO 9020
  439. 9098  REM  ****ITEM INPUT****
  440. 9100  HOME :DLGT = 0
  441. 9110 PM$(1) = "ENTER ITEM -- OR CTL/E TO EXECUTE.": GOSUB 800
  442. 9120  INPUT IN$:IN$ =  LEFT$(IN$,20)
  443. 9130  IF  LEFT$(IN$,1) =  CHR$(5)  AND (DLGT >0)  THEN 9200
  444. 9135  IF  LEN(IN$) = 0  THEN 9120
  445. 9140 DLGT = DLGT +1:DLE$(DLGT) = IN$: GOTO 9120
  446. 9198  REM  ***MATCH & NUL***
  447. 9199  REM  ASSUMES NO DUPL IN FILE$.
  448. 9200  FOR I = 1 TO DLGT: FOR J = 2 TO FLGT +1
  449. 9210  IF FILE$(J) < >DLE$(I)  THEN 9230
  450. 9220 FILE$(J) = "": GOTO 9240
  451. 9230  NEXT J
  452. 9240  NEXT I
  453. 9298  REM  ***MOVE INTO MERGE$***
  454. 9300 J = 0: REM  MERGE$ INDEX
  455. 9310  FOR I = 2 TO FLGT +1
  456. 9320  IF FILE$(I) = ""  THEN 9330
  457. 9325 J = J +1:MERGE$(J) = FILE$(I)
  458. 9330  NEXT I
  459. 9398  REM  MOVE BACK INTO FILE$
  460. 9400 FLGT = J: REM  NATURALLY!
  461. 9410  FOR I = 2 TO FLGT +1:FILE$(I) = MERGE$(I -1): NEXT I
  462. 9420 FILE$(1) =  STR$(FLGT)
  463. 9430  CALL  -198:PM$(1) = "DELETION(S) COMPLETED.NOW UPDATING DISC.": GOSUB 800
  464. 9440  GOSUB 9500: RETURN 
  465. 9480  HOME : PRINT "NO FILES EXIST IN MEMORY. SELECT A FILE FROM MENU 1ST...": FOR D = 1 TO 3000: NEXT D: RETURN 
  466. 9497  REM 
  467. 9498  REM  *** WRITE A FILE ***
  468. 9499  REM 
  469. 9500  PRINT D$;"OPEN ";FLNAME$;",L20": PRINT D$;"DELETE ";FLNAME$
  470. 9505  PRINT D$;"OPEN ";FLNAME$;",L20": PRINT D$;"WRITE ";FLNAME$
  471. 9510  FOR I = 0 TO FLGT +1: PRINT FILE$(I): NEXT I
  472. 9520  PRINT D$;"CLOSE"
  473. 9530  RETURN 
  474. 9997  REM 
  475. 9998  REM  *** READ A FILE ***
  476. 9999  REM 
  477. 10000  PRINT D$;"OPEN ";FLNAME$;",L20"
  478. 10010  PRINT D$;"READ ";FLNAME$
  479. 10020  INPUT FILE$(0): INPUT FILE$(1)
  480. 10030 FLGT =  VAL(FILE$(1))
  481. 10035  FOR K = FLGT +2 TO FLGT +4:FILE$(K) = " ": NEXT K: REM  BLANKS TO AVOID PRNT'G ITEMS FROM LAST FIM.
  482. 10040  FOR K = 2 TO FLGT +1: INPUT FILE$(K): NEXT K
  483. 10044 C = C +1: IF C <20  THEN 10050
  484. 10045 X =  FRE(0):C = 0: REM  FREE UNUSED STRING SPACE ONE 20TH READ.
  485. 10050  PRINT D$;"CLOSE": RETURN 
  486. 10497  REM 
  487. 10498  REM  ***** WRITE CAT *****
  488. 10499  REM 
  489. 10500  PRINT D$;"OPEN ";CTL$(0);",L20": PRINT D$;"DELETE ";CTL$(0)
  490. 10510  PRINT D$;"OPEN ";CTL$(0);",L20": PRINT D$;"WRITE ";CTL$(0)
  491. 10520  FOR I = 0 TO CLGT +1: PRINT CTL$(I): NEXT I
  492. 10530  PRINT D$;"CLOSE"
  493. 10540  RETURN 
  494. 10997  REM 
  495. 10998  REM  *** WRITE CHECK ***
  496. 10999  REM 
  497. 11000  PRINT D$;"OPEN CHECK,L20": PRINT D$;"DELETE CHECK"
  498. 11010  PRINT D$;"OPEN CHECK,L20": PRINT D$;"WRITE CHECK": PRINT CK$(0): PRINT CK$(1): PRINT D$;"CLOSE"
  499. 11020  RETURN 
  500. 11497  REM 
  501. 11498  REM  **** TITLE ****
  502. 11499  REM 
  503. 11500  PRINT "CATALOG NAME---";: INVERSE : PRINT CTL$(0): NORMAL : PRINT "NMBR OF FILES--";: INVERSE : PRINT CLGT: NORMAL 
  504. 11510  RETURN 
  505. 11997  REM 
  506. 11998  REM  ***SEARCH/INSERT CAT***
  507. 11999  REM 
  508. 12000  IF FLNAME$ <CTL$(2)  THEN 12070
  509. 12010 I = 1:CTL$(CLGT +2) =  CHR$(255): REM  IF CLGT IS ODD.
  510. 12020 I = I +1
  511. 12030  IF FLNAME$ >CTL$(I)  AND FLNAME$ <CTL$(I +1)  THEN 12050
  512. 12040  GOTO 12020
  513. 12050  FOR J = CLGT +2 TO I +2  STEP  -1:CTL$(J) = CTL$(J -1): NEXT J: REM  MOVE UP,
  514. 12060 CTL$(I +1) = FLNAME$:CLGT = CLGT +1: RETURN : REM  INSERT.
  515. 12070  FOR I = CLGT +2 TO 3  STEP  -1:CTL$(I) = CTL$(I -1): NEXT I:CTL$(2) = FLNAME$:CLGT = CLGT +1: RETURN : REM  PUT AT BEGINNING.